Developer CD Series 1992 June: ROMin Holiday/ADC Developer CD (1992-06) (''ROMin Holiday'')_iso/Developer Connection - 06-1992.iso/Development Platforms/HyperCard Related/XCMDs & XFCNs/DrawBitmapInRect/DrawBitmapInRect.p

Text File | 1991-03-29 | 9.2 KB | 380 lines | [TEXT/MPS ]

{$R-}
{$S DrawBitmapInRect }

{

    DrawBitmapInRect (TargetRect, TextLabel, [DPI])

     This HyperCard XFCN creates a drawing with the bounds that are passed in
    TargetRect and leaves it on the clipboard to be pasted by HyperCard.

    The drawing that results is strictly a bitmap, and hence does not contain
    any draw objects (except the bitmap itself).

    TargetRect will be the picture frame of the PICT.  Its size is limited
    to 0 (top and left) and 2800 (bottom and right).

    DPI is an optional parameter which defaults to 72.  It can be any
    number from 72 to 400.  It is the scaling factor which determines the
    spatial resolution of the bitmap that is produced.

    For instance, a DPI of 144 results in double the number of pixels in each
    direction.  A DPI of 288 results in 4 times the number of pixels in each
    direction, etc.  A 300 DPI bitmap is ideal for displaying on a LaserWriter.

    If it is successful, then empty is returned, otherwise the return value
    is an error message.

    The drawing that is created is very boring: just a rectangle with an
    X drawn through it, and a string drawn somewhere within it.

    Use this XFCN as a template for others that make more useful drawings.

}

UNIT DummyUnit;

INTERFACE

    USES {* ToolIntf, PackIntf, *}
            Menus, Events, TextEdit, HyperXCmd,
            MemTypes, OSIntf, Scrap, QuickDraw, SANE;

    PROCEDURE EntryPoint(paramPtr: XCmdPtr);

IMPLEMENTATION

    PROCEDURE DrawBitmapInRect(paramPtr: XCmdPtr);
    FORWARD;

    PROCEDURE EntryPoint(paramPtr: XCmdPtr);
    BEGIN
        DrawBitmapInRect(paramPtr)
    END { entrypoint } ;


    PROCEDURE DrawBitmapInRect(paramPtr: XCmdPtr);
    CONST

    MinParams =        2;
    MaxParams =        3;

    TYPE

    ParamArray =        PACKED ARRAY [1..MaxParams] OF Str255;

    VAR

    ParamStrings:        ParamArray;

    TargetRectParam:    Rect;
    TextLabelParam:        Str255;
    DPIParam:            Integer;

    ScaleFactor:        Extended;

    ThePict:            PicHandle;
    TheBitMap:            BitMap;


        PROCEDURE ExitWithString(aString: Str255);
        BEGIN
            WITH paramPtr^ DO BEGIN
                returnValue := PasToZero(paramPtr, aString);
                EXIT(DrawBitmapInRect);
            END;
        END;

        PROCEDURE ExitWithError(aString: Str255);
        BEGIN
            ExitWithString(concat('•••••••• Error: ', aString, '.'));
        END;

        PROCEDURE LimitRectValue(VAR ARect: Rect);
        BEGIN
            IF (ARect.Left < 0) THEN ARect.Left := 0;
            IF (ARect.Top < 0) THEN ARect.Top := 0;
            IF (ARect.Right > 2800) THEN ARect.Right := 2800;
            IF (ARect.Bottom > 2800) THEN ARect.Bottom := 2800;
        END;

        PROCEDURE LimitDPIValue(VAR DPI: Integer);
        BEGIN
            IF (DPI < 72) THEN DPI := 72;
            IF (DPI > 400) THEN DPI := 400;
        END;

        {
            This is where the drawing is done.
            DrawRect is the boundary of the drawing.

            Drawing is done in whatever Quickdraw context is current -- that is,
            the code in this routine should be insensitive to whether drawing
            is happening inside a bitmap or inside a PICT.

            For this sample XFCN, a border is drawn around/within the given rect,
            an X is drawn across the rect, and the string specified by
            TextLabelParam is drawn somewhere in the middle.

         }
        FUNCTION DoTheDrawing(DrawRect: Rect): BOOLEAN;
        VAR

            PenWidth:            Integer;
            PenHeight:            Integer;

            Top:                LONGINT;
            Left:                LONGINT;
            Bottom:                LONGINT;
            Right:                LONGINT;

        BEGIN

            PenWidth := 2;
            PenHeight := 2;

            Left := DrawRect.Left;
            Top := DrawRect.Top;
            Right := DrawRect.Right;
            Bottom := DrawRect.Bottom;

            { Make some calculations -- adjusting these for the pen size }
            Right := Right - PenWidth;
            Bottom := Bottom - PenWidth;

            { Start drawing }
            PenSize(PenWidth,PenHeight);
            MoveTo(Left,Top);
            LineTo(Left,Bottom);
            LineTo(Right,Bottom);
            LineTo(Right,Top);
            LineTo(Left,Top);

            MoveTo(Left,Top);
            LineTo(Right,Bottom);

            MoveTo(Right,Top);
            LineTo(Left,Bottom);

            MoveTo(Left + 30, Top + 20);
            DrawString(TextLabelParam);

            DoTheDrawing := TRUE;

        END;

        { Here we set up a 72 DPI bitmap of sufficient size so that when it is copied
          back to the destination RECT, a bitmap of DPIParam resolution will result.
        }
        PROCEDURE GenerateBitmap; { failure if the returned bitmap.baseAddr is NIL}
        VAR

            OldGrafPtr:        GrafPtr;

            aGrafPort:        GrafPort;
            aGrafPtr:        GrafPtr;

        BEGIN

            { Allocate space for the bitmap & fail if it fails }
            TheBitMap.bounds.left := Num2Integer(ScaleFactor * Num2Extended(TargetRectParam.left));
            TheBitMap.bounds.top := Num2Integer(ScaleFactor * Num2Extended(TargetRectParam.top));
            TheBitMap.bounds.right := Num2Integer(ScaleFactor * Num2Extended(TargetRectParam.right));
            TheBitMap.bounds.bottom := Num2Integer(ScaleFactor * Num2Extended(TargetRectParam.bottom));

            TheBitMap.rowBytes := (((TheBitMap.bounds.right - TheBitMap.bounds.left) + 15) div 16) * 2;
            TheBitMap.baseAddr :=
                    NewPtr(LONGINT(TheBitMap.rowBytes) *
                            LONGINT((TheBitMap.bounds.bottom - TheBitMap.bounds.top)));

            { Set up the return value at this point, and then fail if the allocation failed.}
            IF (TheBitMap.baseAddr = NIL) THEN Exit(GenerateBitmap);

            { Remember the old GrafPort }
            GetPort(OldGrafPtr);

            { Set up the new GrafPort }
            aGrafPtr := @aGrafPort;

            OpenPort(aGrafPtr);

            aGrafPort.portBits := TheBitMap;
            aGrafPort.portRect := TheBitMap.bounds;
            RectRgn(aGrafPort.visRgn, TheBitMap.bounds);
            RectRgn(aGrafPort.clipRgn, TheBitMap.bounds);

            { Clear all of the bits in the bitmap to zeros }
            EraseRgn(aGrafPort.clipRgn);

            { And do the drawing -- which may fail & make us unwind & fail, too}
            IF (DoTheDrawing(TheBitMap.bounds) <> TRUE)
            THEN BEGIN
                DisposPtr(TheBitMap.baseAddr);
                TheBitMap.baseAddr := NIL; { The signal of failure }
            END;

            { Restore the original GrafPort }
            SetPort(OldGrafPtr);

            { Free the GrafPort we’ve been using}
            ClosePort(aGrafPtr);
        END;

        PROCEDURE DisposeBitmap(theMap: BitMap);
        BEGIN
            DisposPtr(theMap.baseAddr);
        END;

        FUNCTION GeneratePict: PicHandle;

        VAR
            OldGrafPtr:        GrafPtr;

            aGrafPort:        GrafPort;
            aGrafPtr:        GrafPtr;

            ThePict:            PicHandle;
        BEGIN

            {The default return value is NIL: failure }
            GeneratePict := NIL;

            { Make the bitmap and fail if it failed.}
            GenerateBitmap;
            IF TheBitmap.baseAddr = NIL THEN Exit(GeneratePict);

            { Remember the old GrafPort }
            GetPort(OldGrafPtr);

            { Set up a new GrafPort }
            aGrafPtr := @aGrafPort;

            OpenPort(aGrafPtr);

            aGrafPort.portRect := TargetRectParam;
            RectRgn(aGrafPort.visRgn, TargetRectParam);
            RectRgn(aGrafPort.clipRgn, TargetRectParam);

            { Open the Pict }
            ThePict := OpenPicture(TargetRectParam);

            { Copy the bitmap onto the pict -- not really onto the current port.}
            CopyBits(theBitmap, aGrafPort.portBits, TheBitmap.bounds, TargetRectParam, srcCopy, NIL);

            { Dispose of the bitmap that was created. }
            DisposeBitmap(TheBitmap);

            { Close and return }
            ClosePicture;
            GeneratePict := ThePict;

            { Restore the original GrafPort }
            SetPort(OldGrafPtr);

            { Free the GrafPort we’ve been using}
            ClosePort(aGrafPtr);
        END;

        PROCEDURE DisposePict(ThePict: PicHandle);
        BEGIN
            KillPicture(ThePict);
        END;

        FUNCTION PutPictOntoClipboard(ThePict: PicHandle): OsErr;
        VAR
            ErrValue:        LONGINT;
        BEGIN

            ErrValue := ZeroScrap;
            PutPictOntoClipboard := ErrValue;
            IF (ErrValue <> NoErr)
            THEN Exit(PutPictOntoClipboard);

            HLock(Handle(ThePict));
            ErrValue := PutScrap(GetHandleSize(Handle(ThePict)),'PICT', Ptr(ThePict^));
            HUnlock(Handle(ThePict));

            PutPictOntoClipboard := ErrValue;
            IF (ErrValue <> NoErr)
            THEN Exit(PutPictOntoClipboard);

        END;

        PROCEDURE CleanUpBeforeEnding;
        BEGIN
            DisposePict(ThePict);
        END;

        PROCEDURE FailWithError(aString: Str255);
        BEGIN

            CleanUpBeforeEnding;
            ExitWithError(aString);
        END;

        PROCEDURE ParseParams;
        VAR
            ParamNum:            integer;
        BEGIN
            WITH paramPtr^ DO
            BEGIN
                IF (paramCount < MinParams) THEN ExitWithError('Too few parameters');
                IF (paramCount > MaxParams) THEN ExitWithError('Too many parameters');

                ParamNum := 1; {* Required *}

                ZeroToPas(ParamPtr, Params[ParamNum]^, ParamStrings[ParamNum]);
                StrToRect(paramPtr, ParamStrings[ParamNum], TargetRectParam);
                LimitRectValue(TargetRectParam);

                ParamNum := 2; {* Required *}

                ZeroToPas(paramPtr, Params[ParamNum]^, ParamStrings[ParamNum]);
                TextLabelParam := ParamStrings[ParamNum];

                ParamNum := 3; {* Optional *}

                IF (paramCount >= ParamNum) THEN
                    BEGIN
                        ZeroToPas(paramPtr, params[ParamNum]^, ParamStrings[ParamNum]);
                        DPIParam := StrToNum(paramPtr, ParamStrings[ParamNum]);
                        LimitDPIValue(DPIParam);
                    END
                ELSE
                    BEGIN
                        DPIParam := 72;
                    END;


            END;
        END;


    BEGIN {DrawBitmapInRect}

        WITH paramPtr^ DO
        BEGIN

            ParseParams;

            ScaleFactor := Num2Extended(DPIParam) / Num2Extended(72); { 1.0 <= ScaleFactor < 5.0 }

            ThePict := GeneratePict;
            IF (ThePict = NIL) THEN
            ExitWithError('Failed while generating picture');

            IF (PutPictOntoClipboard(ThePict) <> NoErr)
            THEN FailWithError('Couldn’t place PICT on clipboard');

            CleanUpBeforeEnding; { i.e. dispose of the PICT before quitting }

            ExitWithString('');

        END

    END { DrawBitmapInRect } ;

END. { DummyUnit }